home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol350 / prolog.arc / SAMPLES.ARC / LISP.PRO < prev    next >
Encoding:
Text File  |  1986-07-20  |  2.1 KB  |  99 lines
  1. /* LISP Splicing operations, by Li Su of Richfield, Minnesota: */
  2.  
  3.  
  4. car(X,L) :- nth(X,L,1).
  5.  
  6. first(X,L) :- nth(X,L,1).
  7.  
  8. second(X,L) :- nth(X,L,2).
  9.  
  10. third(X,L) :- nth(X,L,3).
  11.  
  12. fourth(X,L) :- nth(X,L,4).
  13.  
  14. fifth(X,L) :- nth(X,L,5).
  15.  
  16. sixth(X,L) :- nth(X,L,6).
  17.  
  18. /* put the nth element of the list L to X */
  19.  
  20. nth(X,L,N) :-
  21.           N > 0,
  22.           ((L = []);
  23.            (length(L,Len),Len >= N)),
  24.           decvar [carx],
  25.           carx set '[]',
  26.           not(pcar(L,N)),
  27.           X = val(carx),
  28.           undec carx,!.
  29.  
  30. pcar([H|T],N) :-
  31.              N > 0,
  32.              M is N - 1,
  33.              carx set H,
  34.              nextcar(T,M).
  35.  
  36. nextcar(L,N) :- pcar(L,N).
  37.  
  38. cdr(R,L) :- rest(R,L,1).
  39.  
  40. last(R,L) :-
  41.           length(L,Y),
  42.           Z is Y - 1,
  43.           rest(R,L,Z).
  44.  
  45. /* put the rest of the list L starting from the nth element to R */
  46.  
  47. rest(R,L,N) :-
  48.            N > 0,
  49.            length(L,Len),
  50.            Len >= N,
  51.            decvar [cdrx],
  52.            not(pcdr(L,N)),
  53.            R = val(cdrx),
  54.            undec cdrx,!.
  55.  
  56. pcdr([H|T],N) :-
  57.               N > 0,
  58.               M is N - 1,
  59.               cdrx set T,
  60.               nextcdr(T,M).
  61.  
  62. nextcdr(L,N) :- pcdr(L,N).
  63.  
  64. mklist(L,X,Y) :- L = [X,Y],!.
  65.  
  66. append([],L,L).
  67.  
  68. append([X|L1],L2,[X|L3]) :- append(L1,L2,L3).
  69.  
  70. /* get a list out from an atom */
  71. /* getl(X,2,4,abcdefg), X will be [b,c,d] */
  72.  
  73. getl(Result,Col1,Col2,List) :-
  74.             Col2 >= Col1,
  75.             length(List,Len),
  76.             M is Len - Col2,
  77.             N is Col1 - 1,
  78.             ((N = 0,L1 = List);
  79.              rest(L1,List,N)),
  80.             ((M = 0,Result = L1);
  81.              cond(reverse(L1,L2),
  82.                   rest(L3,L2,M),
  83.                   reverse(L3,Result))),!.
  84.  
  85. reverse([],[]).
  86.  
  87. reverse([H|T],L) :-
  88.                  reverse(T,X),
  89.                  append(X,[H],L).
  90.  
  91. /* get a new atom out from an atom (line) */
  92. /* fread(X,2,4,abcedf), X will be bce */
  93.  
  94. fread(Result,Col1,Col2,Line) :-
  95.                  name(Line,List),
  96.                  getl(L,Col1,Col2,List),
  97.                  name(Result,L),!.
  98.  
  99.